perm filename TABL.F4[RST,LCS] blob
sn#217901 filedate 1976-05-30 generic text, type T, neo UTF8
00100 C** TABL.F4 ** CONVERTS STANDARD NOTATION TO 1700 LUTE TABLATURE.
00200
00300 SUBROUTINE EXTRA
00400 IMPLICIT INTEGER(A-Q,S-Z)
00500 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /STF/RSC(8),RSTJ2
00600 1 /POSI/SF(8),JJ2,RPOS /PTR/KWDS(250),ITEM,L,I,IX /XRN/RN(2000)
00700 EQUIVALENCE (R4,RJQ(2)),(J5,JQ(3)),(R6,RJQ(4)),(R3,RJQ(1))
00800 1 ,(J6,JQ(4)),(R11,RJQ(9)),(J10,JQ(8)),(R5,RJQ(3)),(J3,JQ(1))
00900 1,(J11,JQ(9)),(RX3,RJQ(20)),(R9,RJQ(7)),(R8,RJQ(6)),(JR3,RJQ(19))
01000 1,(J7,JQ(5)),(R10,RJQ(8))
01100
01200 DIMENSION RS(5),KEY(10),ISTR(6)
01300 DATA RS/2.,4.,6.,9.,11./,KEY/3,0,4,1,-1,5,2,6,3,0/
01400 1,ISTR/0,5,8,12,17,20/,KSIG/9/
01500 C RS CONVERTS STRING NUM TO LINE NUM. KEY INCL'S. 4b TO 5#
01600 C ISTR HAS 12-TONE NOTE NUM OF STRINGS 1 TO 6(A=0)
01700
01800 GO TO (1,2),JA
01900 1 IF(KSIG.LE.8)GO TO 51
02000 C NEXT SEARCHES FOR KSIG, AT LEAST ONCE. SET P11=8 TO CANCEL KSIG FEATURE
02100 IF(J11.NE.0)GO TO 51
02200 DO 52 K=1,ITEM
02300 L=KWDS(K)
02400 IF(RN(L+1).NE.17)GO TO 52
02500 IF(RN(L+2).NE.R2)GO TO 52
02600 KSIG=RN(L+5)
02700 GO TO 51
02800 52 CONTINUE
02900 KSIG=8
03000 C SO IT WON'T SEARCH EVERY TIME. NOW KSIG MUST BE SET BY P11.
03100 GO TO 51
03200 15 J10=0
03300 51 IF(J10.NE.0)GO TO 50
03400 C STRNG NUM CAN BE SET IN J10 OR IN R6 -- 1=.001, 2=.002, ETC. J10 IS FIRST.
03500 C R6 IS USED IN 'TAB.F4' WHICH CONVERTS TABLATURE TO MS INPUT.
03600 R6=AMOD(R6*100.0,10.0)
03700 C R6 WAS MULTIPLIED BY 10 IN NOTWRT. .001 HAS BECOME .01, ETC.
03800 J10=R6
03900 IF(J10.NE.0)J6=0
04000 C MAKE J6=0 IF AUTOMATIC STRING NUMS ARE IN DECIS OF R6.
04100 R6=0
04200 50 IF(J10.EQ.0)GO TO 18
04300 C TO SPECIFY LETTER (P6), P10 MUST! ALSO BE NON-ZERO. (USE P10>6 FOR STR.0)
04400 CC******* IF(J10.GT.6)J10=7
04500 J10=7-J10
04600 IF(J6.LE.0)GO TO 18
04700 C J10 SETS STRING# (1→12), J6 SETS LET. OR NUM.(e.g.'-4' PRINTS '4',1=A)
04800 C STRINGS ARE NUMBERED FROM HIGH TO LOW
04900 L=J10*2-1
05000 C GETS STAFF POS FROM STRING NUM.
05100 N=J6-1
05200 IF(J10.GE.0.AND.N.GE.0)GO TO 9
05300 CC******* N=N+1
05400 CC****** N=-N-1
05450 J=J10
05500 C TO PRINT LETTERS OTHER THAN 'A' ON BASS STRINGS
05510 IF(J6)J=J6
05520 C NEG VALUES .LE. -4 WILL PRINT BASS STRING NUMBERS ONLY.
05600 16 L=-1
05700 C STRINGS 0 TO -6 ALL APPEAR BELOW 6-LINE STAFF.
05800 IF(J.GE.0)GO TO 9
05900 C JUMP IF FINGERED NOTE ON STRING 0
06000 CC****** IF(N.EQ.0)GO TO 13
06100 L=-2
06200 IF(J.LT.-3)GO TO 30
06300 C NEXT FOR SLASHES OVER a.
06400 R4=1.0
06500 R5=2.4
06600 IF(J.EQ.-1)GO TO 33
06700 L=-3
06800 R4=0
06900 R5=1.4
07000 33 JR3=R3
07100 C SAVE FOR LATER
07200 R3=R3-7.*RSTJ2
07300 R6=RX3+4*RSTJ2
07400 C RX3 IS ORIG. HORIZ. POS. (SCALE 0-200)
07500 JA=4
07600 J7=1
07700 RP=RPOS
07800 C SAVE VERT. POS. BASIS
07900 DO 32 K=1,-J
08000 J10=1
08100 R8=4.2
08200 R9=0
08300 CALL ITMSUB
08400 J3=JR3
08500 RPOS=RP
08600 R4=R4+.7
08700 32 R5=R5+.7
08800 CC IF(N.NE.0)N=N-1
08900 C GET THE RIGHT LETTER
08910 IF(R10.EQ.0)N=0
09000 GO TO 9
09300 30 R4=51009999.0
09400 GO TO 13
09500
09600 18 J=MOD(J5,10)
09700 M=R4
09800 IF(M.GT.-2)GO TO 21
09900 J=M+2
09950 N=-J
10000 GO TO 16
10100 21 N=MOD(M-1,7)+2
10200 IF(N.GT.6)N=N-7
10300 C N IS NOTE NUMBER, WHERE A3=0
10400 IF(N)GO TO 16
10500 C FOR ALL NOTES BELOW A3 GO BACK TO J6 ROUTINE.
10600 IF(J.EQ.0)GO TO 6
10700 C JUMP IF NO ACCI.
10800
10900 IF(J.EQ.1)J=-1
11000 IF(J.EQ.2)J=1
11100 IF(J.EQ.3)J=0
11200 C J= 1/2 STEP FROM CENTRAL PITCH
11300 GO TO 7
11400 6 IF(J11.NE.0)KSIG=J11
11500 IF(KSIG.GT.7)GO TO 7
11600 C J11>7 CANCELS KSIG
11700 C GIVE KEYSIG. IN P11 +=#, -=b
11800 M=KSIG+5
11900 J=1
12000 IF(KSIG)J=-1
12100 DO 4 K=5,M,J
12200 4 IF(N.EQ.KEY(K))GO TO 7
12300 C LOOK FOR THE NOTE IN THE KEYSIG.
12400 J=0
12500 C 0= NOT FOUND IN KEYSIG.
12600 7 R11=0
12700 IF(J10.GT.0)GO TO 5
12800 C JUMP IF STRING IS SPECIFIED
12900 DO 10 L=1,5
13000 10 IF(R4.LT.RS(L))GO TO 20
13100 L=6
13200 C L IS STRING NUMBER.
13300 20 L=L*2-1
13400 IF(J.GE.0)GO TO 5
13500 C NEXT CHECKS FOR FLATS THAT CHANGE STRING NUM.
13600 IF(N.EQ.0)GO TO 8
13700 IF(N.EQ.3)GO TO 8
13800 IF(N.NE.5)GO TO 5
13900 CC8 L=L-1
14000 C CHANGES Ab→G#, Db→C#
14100 CC N=N-1
14200 CC J=1
14300 8 R4=R4-1.
14400 J5=2
14500 GO TO 18
14600 C DOESN'T ACCOUNT FOR F FLAT, ETC.
14700
14800 5 NN=N*2
14900 C NEXT CONVERTS TO 12-TONE NUMS.
15000 IF(N.GT.1)NN=NN-1
15100 IF(N.GT.4)NN=NN-1
15200 C COMPENSATES FOR B-C AND E-F 1/2 STEPS IN SCALE
15300 N=NN
15400 IF(J10.GT.0)GO TO 14
15500 IF(R4.GE.13)GO TO 17
15600 IF(NN.GT.4)N=NN-5
15700 IF(NN.GT.7)N=NN-8
15800 C N IS NOW A LETTER ON A OR D OR F STRING (0=A, 1=B, ETC.)
15900
16000 11 N=N+J
16100 GO TO 9
16200 17 J10=6
16300 14 IF(J10.GT.6)GO TO 15
16400 R5=R4
16500 IF(J)R5=R5-1.
16600 IF(R5.GE.6.)N=N+12
16700 IF(R5.GE.13.)N=N+12
16800 N=N-ISTR(J10)+J
16900 IF(N)GO TO 15
17000 L=J10*2-1
17100
17200 9 IF(N.GT.8)N=N+1
17250 R4=51709999.0
17300 C SKIPS THE LETTER 'J'
17400 31 IF(N.EQ.2)N=17
17500 C CHANGES C TO R
17600 13 R6=R4+N*10000
17700 R5=.95
17800 R4=L+1.28125
17900 IF(N.EQ.3)R11=268
18000 C ROTATES 'D'
18100 J3=J3+6.*RSTJ2
18200 CALL ALPHA
18300 2 END